home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / include / object.h < prev    next >
C/C++ Source or Header  |  1992-11-08  |  7KB  |  270 lines
  1. #ifndef OBJECT_H
  2. #define OBJECT_H
  3.  
  4. #define VALBITS         24
  5. #define VALMASK         ((1 << VALBITS) - 1)
  6. #define SIGNBIT         (1 << (VALBITS-1))
  7. #define SIGNMASK        ~(SIGNBIT-1)
  8. #define FIXNUM_FITS(x)  (((x) & SIGNMASK) == 0 || ((x) & SIGNMASK) == SIGNMASK)
  9. #define FIXNUM_FITS_UNSIGNED(x)     (((x) & SIGNMASK) == 0)
  10.  
  11. #define CONSTBIT        (1 << VALBITS)
  12.  
  13. #define TYPESHIFT       (VALBITS+1)
  14.  
  15. typedef unsigned Object;
  16.  
  17. #define MAX_TYPE        (1 << (sizeof(Object)*8 - TYPESHIFT))
  18.  
  19. /* Extract/Set/Compare the type and val components of Objects:
  20.  */
  21.  
  22. #define TYPE(x) ((int)((x) >> TYPESHIFT))
  23. #define SETTYPE(x,t) ((x) = ((x) & VALMASK) | ((x) & CONSTBIT) | \
  24.                 ((int)(t) << TYPESHIFT))
  25.  
  26. #define FIXNUM(x) (((int)(x) << (32-VALBITS)) >> (32-VALBITS))
  27.  
  28. #define SETFIXNUM(x,i) ((x) = ((x) & ~VALMASK) | ((i) & VALMASK))
  29.  
  30. #define CHAR(x) ((int)((x) & VALMASK))
  31.  
  32. #ifndef POINTER_CONSTANT_HIGH_BITS
  33. #  define POINTER(x) ((x) & VALMASK)
  34. #else
  35. #  define POINTER(x) (((x) & VALMASK) | POINTER_CONSTANT_HIGH_BITS)
  36. #endif
  37. #define SETPOINTER(x,p) SETFIXNUM(x,(int)(p))
  38.  
  39. #define ISCONST(x) ((x) & CONSTBIT)
  40. #define SETCONST(x) ((x) |= CONSTBIT)
  41.  
  42. #define SET(x,t,p) ((x) = ((int)(t) << TYPESHIFT) | ((int)(p) & VALMASK))
  43.  
  44. #define EQ(x,y) ((x) == (y))
  45.  
  46. #define SETFAST(x,y) ((x) = (y))
  47.  
  48. /* GC related macros:
  49.  */
  50. #ifdef GENERATIONAL_GC
  51.    /* not yet there */
  52. #else
  53. #  define WAS_FORWARDED(obj) (TYPE(*(Object *)POINTER(obj)) == T_Broken_Heart)
  54. #  define IS_ALIVE(obj)      WAS_FORWARDED(obj)
  55. #  define UPDATE_OBJ(obj)    SETPOINTER(obj, POINTER(*(Object *)POINTER(obj)))
  56. #  define REVIVE_OBJ(obj)
  57. #endif
  58.  
  59. /* Fixed types.  Cannot use enum, because the set of types is extensible:
  60.  */
  61. #define T_Fixnum          0      /* Must be 0 */
  62. #define T_Bignum          1
  63. #define T_Flonum          2
  64. #define T_Null            3      /* empty list */
  65. #define T_Boolean         4      /* #t (1) and #f (0) */
  66. #define T_Void            5      /* doesn't print */
  67. #define T_Unbound         6      /* only used internally */
  68. #define T_Special         7      /* only used internally */
  69. #define T_Character       8
  70. #define T_Symbol          9
  71. #define T_Pair           10
  72. #define T_Environment    11      /* A pair */
  73. #define T_String         12
  74. #define T_Vector         13
  75. #define T_Primitive      14      /* Primitive procedure */
  76. #define T_Compound       15      /* Compound procedure */
  77. #define T_Control_Point  16
  78. #define T_Promise        17      /* Result of (delay expression) */
  79. #define T_Port           18
  80. #define T_End_Of_File    19
  81. #define T_Autoload       20
  82. #define T_Macro          21
  83. #define T_Broken_Heart   22      /* only used internally */
  84.  
  85. #define T_Last T_Broken_Heart
  86.  
  87. #define BIGNUM(x)   ((struct S_Bignum *)POINTER(x))
  88. #define FLONUM(x)   ((struct S_Flonum *)POINTER(x))
  89. #define STRING(x)   ((struct S_String *)POINTER(x))
  90. #define VECTOR(x)   ((struct S_Vector *)POINTER(x))
  91. #define SYMBOL(x)   ((struct S_Symbol *)POINTER(x))
  92. #define PAIR(x)     ((struct S_Pair *)POINTER(x))
  93. #define PRIM(x)     ((struct S_Primitive *)POINTER(x))
  94. #define COMPOUND(x) ((struct S_Compound *)POINTER(x))
  95. #define CONTROL(x)  ((struct S_Control *)POINTER(x))
  96. #define PROMISE(x)  ((struct S_Promise *)POINTER(x))
  97. #define PORT(x)     ((struct S_Port *)POINTER(x))
  98. #define AUTOLOAD(x) ((struct S_Autoload *)POINTER(x))
  99. #define MACRO(x)    ((struct S_Macro *)POINTER(x))
  100.  
  101. typedef unsigned short gran_t;    /* Granularity of bignums */
  102.  
  103. struct S_Bignum {
  104.     Object minusp;
  105.     unsigned size;        /* Number of ushorts allocated */
  106.     unsigned usize;        /* Number of ushorts actually used */
  107.     gran_t data[1];        /* Data, lsw first */
  108. };
  109.  
  110. struct S_Flonum {
  111.     Object tag;               /* Each S_Foo must start with an Object */
  112.     double val;
  113. };
  114.  
  115. struct S_Symbol {
  116.     Object next;
  117.     Object name;               /* A string */
  118.     Object value;
  119.     Object plist;
  120. };
  121.  
  122. struct S_Pair {
  123.     Object car, cdr;
  124. };
  125.  
  126. struct S_String {
  127.     Object tag;
  128.     int size;
  129.     char data[1];
  130. };
  131.  
  132. struct S_Vector {
  133.     Object tag;
  134.     int size;
  135.     Object data[1];
  136. };
  137.  
  138. enum discipline { EVAL, NOEVAL, VARARGS };
  139. struct S_Primitive {
  140.     Object tag;
  141.     Object (*fun) P_((ELLIPSIS));
  142.     char *name;
  143.     int minargs;
  144.     int maxargs;    /* Or MANY */
  145.     enum discipline disc;
  146. };
  147. #define MANY    100
  148.  
  149. struct S_Compound {
  150.     Object closure;     /* (lambda (args) form ...) */
  151.     Object env;         /* Procedure's environment */
  152.     int min_args, max_args;
  153.     Object name;
  154. };
  155.  
  156. typedef struct wind {
  157.     struct wind *next, *prev;
  158.     Object inout;                  /* Pair of thunks */
  159. } WIND;
  160.  
  161. typedef struct funct {
  162.     struct funct *next;
  163.     void (*func) P_((void));
  164. } FUNCT;
  165.  
  166. typedef struct gcnode {
  167.     struct gcnode *next;
  168.     int gclen;
  169.     Object *gcobj;
  170. } GCNODE;
  171.  
  172. typedef struct mem_node {
  173.     struct mem_node *next;
  174.     unsigned len;
  175.     unsigned long refcnt;
  176. } MEM_NODE;
  177.  
  178. struct S_Control {
  179.     Object env;
  180.     GCNODE *gclist;
  181.     MEM_NODE *memlist;
  182.     Object memsave;             /* string */
  183.     Object gcsave;              /* vector */
  184.     WIND *firstwind, *lastwind;
  185.     int tailcall;
  186.     unsigned delta;
  187.     jmp_buf j;
  188.     int size;
  189.     char stack[1];
  190. };
  191.  
  192. struct S_Promise {
  193.     Object env;
  194.     Object thunk;
  195.     int done;
  196. };
  197.  
  198. struct S_Port {
  199.     Object name;    /* string */
  200.     short flags;
  201.     char unread;
  202.     int ptr;
  203.     FILE *file;
  204.     unsigned lno;
  205. };
  206. #define P_OPEN    1 /* flags */
  207. #define P_INPUT   2
  208. #define P_STRING  4
  209. #define P_UNREAD  8
  210. #define P_BIDIR  16
  211.  
  212. #define IS_INPUT(port)   (PORT(port)->flags & (P_INPUT|P_BIDIR))
  213. #define IS_OUTPUT(port) ((PORT(port)->flags & (P_INPUT|P_BIDIR)) != P_INPUT)
  214.  
  215. struct S_Autoload {
  216.     Object files;
  217.     Object env;
  218. };
  219.  
  220. struct S_Macro {
  221.     Object body;
  222.     int min_args, max_args;
  223.     Object name;
  224. };
  225.  
  226.  
  227. /* "size" is called with one object and returns the size of the object.
  228.  *    If "size" is NOFUNC, then "const_size" is taken instead.
  229.  * "eqv" and "equal" are called with two objects and return 0 or 1.
  230.  *    NOFUN may be passed instead (than eqv and equal always return #f).
  231.  * "print" is called with an object, a port, a flag indicating whether
  232.  *    the object is to be printed "raw" (a la display), the print-depth,
  233.  *    and the print-length.
  234.  * "visit" is called with a pointer to an object and a function.
  235.  *    For each component of the object, the function must be called with
  236.  *    a pointer to the component.  NOFUNC may be supplied.
  237.  */
  238. typedef struct {
  239.     int haspointer;
  240.     char *name;
  241.     int (*size) P_((Object));
  242.     int const_size;
  243.     int (*eqv) P_((Object, Object));
  244.     int (*equal) P_((Object, Object));
  245.     int (*print) P_((Object, Object, int, int, int));
  246.     int (*visit) P_((Object*, int (*)(Object*)));
  247. } TYPEDESCR;
  248. #define NOFUNC ((int (*)P_((ELLIPSIS)))0)
  249.  
  250.  
  251. typedef struct sym {
  252.     struct sym *next;
  253.     char *name;
  254.     unsigned long value;
  255. } SYM;
  256.  
  257. typedef struct {
  258.     SYM *first;
  259.     char *strings;
  260. } SYMTAB;
  261.  
  262.  
  263. typedef struct weak_node {
  264.     struct weak_node *next;
  265.     Object object;
  266.     void (*terminate) P_((Object));
  267. } WEAK_NODE;
  268.  
  269. #endif
  270.